home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
pcl
/
src-16f.lha
/
code
/
defrecord.lisp
< prev
next >
Wrap
Lisp/Scheme
|
1992-05-30
|
2KB
|
70 lines
;;; -*- Mode: Lisp; Package: Lisp -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: defrecord.lisp,v 1.2 91/02/08 13:32:02 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; DefRecord -- a thing to take the place of DefAlienStructure.
(in-package 'lisp)
(in-package 'system)
(export '(defrecord record-size))
(in-package 'lisp)
(defun concat-pnames* (name1 name2)
(if name1
(make-symbol (concatenate 'simple-string (symbol-name name1)
(symbol-name name2)))
name2))
#-new-compiler
(eval-when (compile)
(setq lisp::*bootstrap-defmacro* t))
;;; We want to be able to do something like this:
;;;
;;; (defrecord message
;;; (simplep boolean (words 1))
;;; (size (signed-byte 32) (long-words 1))
;;; (type (signed-byte 32) (long-words 1))
;;; (local-port port (long-words 1))
;;; (remote-port port (long-words 1))
;;; (id (signed-byte 32) (long-words 1)))
;;;
(defmacro defrecord (name &rest slots)
`(progn
,(do ((slots slots (cdr slots))
(bit-index 0)
(defops ())
(prefix (concat-pnames* name '-)))
((null slots)
`(eval-when ,*alien-eval-when*
,@(nreverse defops)
(setf (get ',name 'record-size) ,bit-index)))
(let* ((slot (car slots))
(slot-name (car slot))
(type (cadr slot))
(size (eval (caddr slot))))
(push
`(defoperator (,(concat-pnames prefix slot-name) ,type) ((,name ,name))
`(alien-index (alien-value ,,name) ,',bit-index ,',size))
defops)
(incf bit-index size)))))
(defun record-size (name)
(or (get name 'record-size)
(error "~S is not a defined record." name)))
#-new-compiler
(eval-when (compile)
(setq lisp::*bootstrap-defmacro* nil))